!****************************************************************************
!
!  Code for Bianchi, Ottonello and Presno (2021) - Fiscal Stimulus udner Sovereign Risk
!  Model: Risk-free debt model
! 
!  Updated: 12/05/2021
!****************************************************************************

program MAIN
    
USE GLOBAL
!USE FUNCALLER
USE OMP_LIB

implicit none

REAL(8)::uncstda 
REAL(8)::dif,difaut,difq,time
INTEGER(4)::i,j,ii,jj
INTEGER(4)::i_b, i_a,ia0,ib0,iter,iterv
INTEGER::hz,ier,i_a0,i_b0(1)
REAL(8)::ones(na,nb),dos
DOUBLE PRECISION :: a_valor, b_valor,f_valor,indicator_external
REAL(8)::fvalue,auxval,func_gN,func_gN2,func
REAL(8)::a_initial,b_initial,ftol
INTEGER::i_default_global 
REAL(8)::beta0,chi0,icost0,psi10,psi20,wbar0,xval(6),xi(6,6)
REAL(8)::p0,cnval,gnval,fvalor

INTEGER::end_time,cr      

iterfun=0
choice_glob=1

!Instructions:
!For flex wages, set choice_nowbar=1 and wbar=0d0
!For lumpsum taxes, set taxrate=10d0

!flex wages:
!bmin = -1d0    
!bmax =  0.55d0

!lumpsum taxes:
!bmin = -0.41d0    
!bmax =  0.35d0

!baseline:
!bmin = -0.41d0          
!bmax =  0.35d0

!risk-free debt:
bmin = -4d0    
bmax =  3d0
    
version_code=341
      
!           beta              chi       icost        psi1           psi2        wbar  !
xval = [ 0.9803681011d0,     0.12d0,    0.0d0,    1000.3772d0,     2.42d0,     3.068d0 ]


call system_clock(count_rate=cr)
rate_time = REAL(cr)
call system_clock(count=start_time)

call quadrature

uncstda = sigmaa/DSQRT(1d0-rhoa**2d0)    
amin = mua/(1d0-rhoa) - ndevs*uncstda
amax = mua/(1d0-rhoa) + ndevs*uncstda

DO i=1,ns
    agrid(i)= amin + ((REAL(i)-1d0)/(REAL(ns)-1d0))*(amax - amin)
ENDDO    

OPEN(1,FILE='output//agrid.txt')
OPEN(2,FILE='graphs//agrid.txt')

DO i = 1,na
    WRITE(1,*) agrid(i)
    WRITE(2,*) agrid(i)
ENDDO
    
CLOSE(1)
CLOSE(2)

DO i=1,nn
    gngrid(i) = gnmin + ((REAL(i)-1d0)/(REAL(nn)-1d0))*(gnmax - gnmin)
ENDDO 

DO i=1,nn
    hgrid(i) = hmin + ((REAL(i)-1d0)/(REAL(nn)-1d0))*(hmax - hmin)
ENDDO 

do i=1,ncdf
   cdfgrid(i) = cdfmin + (cdfmax - cdfmin) * (i-1) / (ncdf-1)
end do

dos    = 2d+00
epsmin = -4d0*sigmaa
epsmax = 4d0*sigmaa

!grid when using Gauss-Hermite quaradture points 
do i=1,neps
   epsgrid(i) = SQRT(dos)*sigmaa* quad_x_hermite(i)
end do

kw   = omegac/(1d0-omegac)
payoff = 1d0

IF (choice_coup.EQ.1) payoff = lambda+(1d0-lambda)*coup

defaultgrid(1)=0d0
defaultgrid(2)=1d0

ftol=1E-3

xi(:,:)=0d0
FORALL (i=1:6, j=1:6, j.EQ.i) xi(i,j)=1d0

fvalor=func(xval)

  
end program MAIN

